PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/strlink.com/STRLINK.PAS

Pascal/Delphi Source File | 1981-09-01 | 27.9 KB | 865 lines

{$D-,R-,S+}
{$DEFINE TPRO5}

UNIT StrLink;


   {Offers transparent heap-managed linked lists of strings.

Version 1.00: released to the public domain on 28 August 1989.

Version 1.01: released to the public domain on 1 September 1989.
   Forgot to CLOSE() the files in ReadStrings() and WriteStrings().  They're
fixed now.  ...You know how that got by me?  I testing them by writing strings
to the console.  The buffer always flushes immediately.  But it's a disaster
when you write to a disk file!  I discovered the error without Peter Roach's
help but I thank him anyway for noticing it.
   Fixed an endless loop in Retreat().  The ancestor object doesn't return a
NIL when you try to move backwards from the first string on the list.  So, the
logic had to be installed in Retreat().
   Dan Anderson told me that I forgot to check upper/lower case relevancy in
Exists(), ExistsSubString(), and DeleteDuplicates().  How true, how true.
That's been corrected.
   Added a call to the standard procedure FAIL if the Init() constructor hits
the heap ceiling.  It should never hit the ceiling since we automatically have
been allocated enough room on the heap for ourselves (assuming we're dynamic,
of course).  This is done mostly to show people a little bit about the FAIL
procedure and how it applies to dynamic constructors.  Read the TP 5.5 OOP
guide, p.106-107, for a dissertation on FAIL and heap error recovery.  Also,
read chapter 15 of the ref guide for a way to recover gracefully (!) if the
heap ceiling caves in.  Why go for an abort-203 when you can terminate in a
friendly way?
   Turned the AddString() procedure into a function.  It now returns TRUE or
FALSE based on the success of adding the given string to the heap.  If you get
FALSE, it means you're out of room on the heap.  See above for important
information on heap error recovery.
   Made VIRTUAL methods out of ReadStrings & WriteStrings.
   Changed ReadStrings() & WriteStrings() to return a WORD value, not a BYTE
value.  Peter Roach was kind enough to point me to the TP ref manual where it
explains how IORESULT returns a WORD result.  Also, modified code slightly so
it conditionally turns on/off the $I error checking while reading/writing.
   ReadStrings() now returns a value of MAXINT if it runs out of heap while
it reads a file.
   Added new method, TotalLengthOfStrings, which adds up the string lengths
and returns it as a LONGINT.}


INTERFACE {section}


USES
   {$IFDEF TPRO5}
       TpString,
   {$ENDIF}
   Objects,
   ObjectA,
   StrObj;

TYPE
   SortedOrderType = (ForwardOrder,
              ReverseOrder,
              AscendingOrder,
              DescendingOrder);

   StrLinkList
    = OBJECT(LinkList)
      CurrentStrPtr     : StrObjectPtr;
      UniqueStringsOnly : BOOLEAN;
      SortedOrder       : SortedOrderType;
      CaseMatters       : BOOLEAN;

      CONSTRUCTOR Init(UniqueStrings : BOOLEAN;
                       SortSpecifier : SortedOrderType;
                       IgnoreCase    : BOOLEAN);

      FUNCTION  GetSpecificString(NodePos : LONGINT) : STRING;
      PROCEDURE DeleteSpecificString(NodePos : LONGINT);

      FUNCTION  ReadStrings(TheFilename : STRING) : WORD; VIRTUAL;
      FUNCTION  WriteStrings(TheFilename : STRING;
                             AppendFile  : BOOLEAN) : WORD; VIRTUAL;

      FUNCTION  AddString(TheStr : STRING) : BOOLEAN;
      PROCEDURE DeleteString(TheStr : STRING);
      FUNCTION  Exists(TheStr : STRING) : BOOLEAN;
      FUNCTION  ExistsSubstring(TheSubStr : STRING) : BOOLEAN;
      PROCEDURE DeleteStringsWithoutSubstring(TheSubStr  : STRING;
                                              IgnoreCase : BOOLEAN);
      PROCEDURE DeleteStringsWithSubstring(TheSubStr  : STRING;
                                           IgnoreCase : BOOLEAN);
      PROCEDURE DeleteDuplicates;
      PROCEDURE DeleteLeadNullStrings;
      PROCEDURE DeleteNullStrings;
      PROCEDURE DeleteTrailNullStrings;

      FUNCTION  TotalLengthOfStrings : LONGINT;

      PROCEDURE InitCurrent;
      FUNCTION  CurrentString : STRING;
      PROCEDURE ChangeCurrentString(NewStr : STRING);
      FUNCTION  FirstString : STRING;
      FUNCTION  LastString : STRING;
      PROCEDURE Advance;
      PROCEDURE Retreat;
      FUNCTION  MoreStrings : BOOLEAN;
      FUNCTION  NoMoreStrings : BOOLEAN
      END;


IMPLEMENTATION {section}


{$IFNDEF TPRO5}
{============================================================================}
FUNCTION  StUpCase(TheStr : STRING) : STRING;

   {Returns a string, converted to uppercase.}

VAR
   Index : BYTE;

BEGIN {StUpCase}
FOR Index := 1 TO LENGTH(TheStr)
 DO TheStr[Index] := UPCASE(TheStr[Index]);

StUpCase := TheStr
END; {StUpCase}
{============================================================================}
{$ENDIF}

{- - - - - - - - - - - - - - - - - - -  - - - - - - - - - - - - - - - - - - -}

{============================================================================}
CONSTRUCTOR StrLinkList.Init(UniqueStrings : BOOLEAN;
                             SortSpecifier : SortedOrderType;
                             IgnoreCase    : BOOLEAN);

   {This procedure initializes the StrLinkList.}

BEGIN {StrLinkList.Init}
CurrentStrPtr     := NIL;

UniqueStringsOnly := UniqueStrings;
SortedOrder       := SortSpecifier;
CaseMatters       := NOT IgnoreCase;

IF NOT LinkList.Init
 THEN FAIL
END; {StrLinkList.Init}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.GetSpecificString(NodePos : LONGINT) : STRING;

   {This function returns a string from the StrLinkList based on the position
of a particular Str in the list.  The position is represented by NodePos.  It
returns a null string if NodePos is <= 0 or if it is > Total.  CurrentPtr is
set to the specified string.}

BEGIN {StrLinkList.GetSpecificString}
{Initialize.}
CurrentStrPtr := StrObjectPtr(Specific(NodePos));

IF (CurrentStrPtr = NIL)
 THEN GetSpecificString := ''
 ELSE GetSpecificString := CurrentStrPtr^.GetString
END; {StrLinkList.GetSpecificString}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteSpecificString(NodePos : LONGINT);

   {This procedure deletes a string from the StrLinkList based on the position
of the node, represented by NodePos.  It does nothing if NodePos is <= 0 or if
it is > Total.  CurrentPtr is set to NIL afterwards.}

BEGIN {StrLinkList.DeleteSpecificString}
{Initialize.}
CurrentStrPtr := StrObjectPtr(Specific(NodePos));

IF (CurrentStrPtr <> NIL)
 THEN
    BEGIN
    Remove(CurrentStrPtr);
    DISPOSE(CurrentStrPtr,Done);
    CurrentStrPtr := NIL
    END
END; {StrLinkList.DeleteSpecificString}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.ReadStrings(TheFilename : STRING) : WORD;

   {Reads strings from TheFilename and adds them to the link list.  IORESULT
is returned as the result -- unless we ran out of heap, at which point a value
of MAXINT will be returned.}

VAR
   ReadFile : TEXT;
   ReadBuf  : ARRAY [1..2048] OF CHAR;
   ReadLine : STRING;

   AddOkay : BOOLEAN;
   IOerror : WORD;

BEGIN {StrLinkList.ReadStrings}
{$IFOPT I-}
    {$DEFINE INEG}
{$ELSE}
    {$I-}
{$ENDIF}

{Initialize.}
IOerror := IORESULT;
IF (IOerror = 0)
 THEN
    BEGIN
    ASSIGN(ReadFile,TheFilename);
    RESET(ReadFile);
    SETTEXTBUF(ReadFile,ReadBuf);
    IOerror := IORESULT;
    IF (IOerror = 0)
     THEN
        BEGIN
        AddOkay := (IOerror = 0);

        WHILE (AddOkay AND NOT EOF(ReadFile) AND (IOerror = 0))
         DO BEGIN
            READLN(ReadFile,ReadLine);
            IOerror := IORESULT;
            AddOkay := AddString(ReadLine)
            END;

        {Wrap up.}
        IF (IOerror = 0)
         THEN
            BEGIN
            CLOSE(ReadFile);
            IOerror := IORESULT
            END
        END
    END;

IF AddOkay
 THEN ReadStrings := IOerror
 ELSE ReadStrings := MAXINT

{$IFDEF INEG}
    {$UNDEF INEG}
{$ELSE}
    {$I+}
{$ENDIF}
END; {StrLinkList.ReadStrings}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.WriteStrings(TheFilename : STRING;
                                   AppendFile  : BOOLEAN) : WORD;

   {Writes strings from TheFilename and adds them to the link list.  IORESULT
is returned as the result.}

VAR
   WriteFile : TEXT;
   WriteBuf  : ARRAY [1..2048] OF CHAR;
   WriteLine : STRING;
   IOerror   : WORD;

BEGIN {StrLinkList.WriteStrings}
{$IFOPT I-}
    {$DEFINE INEG}
{$ELSE}
    {$I-}
{$ENDIF}

{Initialize.}
IOerror := IORESULT;
IF (IOerror = 0)
 THEN
    BEGIN
    ASSIGN(WriteFile,TheFilename);
    IF AppendFile
     THEN SYSTEM.APPEND(WriteFile)
     ELSE REWRITE(WriteFile);
    SETTEXTBUF(WriteFile,WriteBuf);
    IOerror := IORESULT;

    WHILE (MoreStrings AND (IOerror = 0))
     DO BEGIN
        WRITELN(WriteFile,CurrentStrPtr^.GetString);
        IOerror := IORESULT;
        Advance
        END;

    {Wrap up.}
    IF (IOerror = 0)
     THEN
        BEGIN
        CLOSE(WriteFile);
        IOerror := IORESULT
        END
    END;

WriteStrings := IOerror

{$IFDEF INEG}
    {$UNDEF INEG}
{$ELSE}
    {$I+}
{$ENDIF}
END; {StrLinkList.WriteStrings}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.AddString(TheStr : STRING) : BOOLEAN;

   {This function stores TheStr in the StrLinkList.  It does nothing if the
string is redundant AND UniqueStringsOnly is set to TRUE.  CurrentPtr is
undefined after making this call.  (It may, or may not, point to the current
string.)
   If this function returns FALSE, it means there was not enough heap to add
the string.}

VAR
   TheStrObjPtr : StrObjectPtr;

BEGIN {StrLinkList.AddString}
IF (UniqueStringsOnly AND Exists(TheStr))
 THEN
    BEGIN
    AddString := TRUE;
    EXIT {no need to hang around here, eh?}
    END;

{Create the string object.}
TheStrObjPtr := NEW(StrObjectPtr,Init(TheStr));
IF (TheStrObjPtr = NIL)
 THEN {we ran out of heap!}
    BEGIN
    AddString := FALSE;
    EXIT {no need to hang around here, eh?}
    END;

IF (First = NIL)
 THEN
    Insert(TheStrObjPtr)
 ELSE
    CASE SortedOrder OF
      ForwardOrder :
    Append(TheStrObjPtr);
      ReverseOrder :
    Insert(TheStrObjPtr);
      AscendingOrder :
        BEGIN
        CurrentStrPtr := StrObjectPtr(First);
        IF CaseMatters
         THEN
            WHILE (MoreStrings
             AND (CurrentStrPtr^.GetString < TheStr))
             DO Advance
         ELSE
            {$IFDEF TPRO5}
                WHILE (MoreStrings
                 AND (CompUCString(CurrentStrPtr^.GetString,TheStr) = Less))
                  DO Advance;
            {$ELSE}
                WHILE (MoreStrings
                 AND (StUpCase(CurrentStrPtr^.GetString) < StUpCase(TheStr)))
                  DO Advance;
            {$ENDIF}

        {CurrentStrPtr now points to the first Str coming after TheStr, or it
           has a NIL value.}
        IF NoMoreStrings
         THEN Append(TheStrObjPtr)
         ELSE Before(TheStrObjPtr,CurrentStrPtr)
        END;
      DescendingOrder :
        BEGIN
        CurrentStrPtr := StrObjectPtr(First);
        IF CaseMatters
         THEN
            WHILE (MoreStrings
             AND (CurrentStrPtr^.GetString > TheStr))
             DO Advance
         ELSE
            {$IFDEF TPRO5}
                WHILE (MoreStrings
                 AND (CompUCString(CurrentStrPtr^.GetString,
                                   TheStr) = Greater))
                  DO Advance;
            {$ELSE}
                WHILE (MoreStrings
                 AND (StUpCase(CurrentStrPtr^.GetString) > StUpCase(TheStr)))
                  DO Advance;
            {$ENDIF}

        {CurrentStrPtr now points to the first Str coming after TheStr, or it
           has a NIL value.}
        IF NoMoreStrings
         THEN Append(TheStrObjPtr)
         ELSE Before(TheStrObjPtr,CurrentStrPtr)
        END;
     END; {CASE}

{If we got this far, everything went okay.}
AddString := TRUE
END; {AddString}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.DeleteString(TheStr : STRING);

   {This procedure deletes a string from the StrLinkList.  It does nothing if
the string doesn't exist.  CurrentPtr is NIL after making this call.}

BEGIN {StrLinkList.DeleteString}
IF Exists(TheStr)
 THEN
    BEGIN
    CurrentStrPtr := StrObjectPtr(First);
    WHILE (CurrentStrPtr^.GetString <> TheStr)
     DO CurrentStrPtr := StrObjectPtr(CurrentStrPtr^.Next);

    {CurrentStrPtr now points to the proper string.}
    Remove(CurrentStrPtr);
    DISPOSE(CurrentStrPtr,Done);
    CurrentStrPtr := NIL
    END
END; {StrLinkList.DeleteString}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.Exists(TheStr : STRING) : BOOLEAN;

   {This function determines if the string is on the StrLinkList.}

VAR
   TempBoolean : BOOLEAN;

BEGIN {StrLinkList.Exists}
{Initialize.}
CurrentStrPtr := StrObjectPtr(First);
IF NOT CaseMatters
 THEN TheStr := StUpCase(TheStr);

IF (First = NIL)
 THEN
    Exists := FALSE
 ELSE
    BEGIN
    TempBoolean := FALSE;

    IF CaseMatters
     THEN
        REPEAT
            IF (CurrentStrPtr^.GetString = TheStr)
             THEN TempBoolean := TRUE;
             {ELSE leave TempBoolean alone}

            CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
         UNTIL (TempBoolean OR NoMoreStrings)
     ELSE
        REPEAT
            {$IFDEF TPRO5}
                IF (CompUCString(CurrentStrPtr^.GetString,TheStr) = Equal)
                 THEN TempBoolean := TRUE;
                 {ELSE leave TempBoolean alone}
            {$ELSE}
                IF (StUpCase(CurrentStrPtr^.GetString) = TheStr)
                 THEN TempBoolean := TRUE;
                 {ELSE leave TempBoolean alone}
            {$ENDIF}

            CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
         UNTIL (TempBoolean OR NoMoreStrings);

    Exists := TempBoolean
    END
END; {StrLinkList.Exists}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.ExistsSubstring(TheSubStr : STRING) : BOOLEAN;

   {This function determines if a given substring is on the StrLinkList.  If
TheSubString is null and at least one string exists on the list, then the
function returns as TRUE.}

VAR
   TempBoolean : BOOLEAN;

BEGIN {StrLinkList.ExistsSubstring}
{Initialize.}
CurrentStrPtr := StrObjectPtr(First);
IF NOT CaseMatters
 THEN TheSubStr := StUpCase(TheSubStr);

IF (First = NIL)
 THEN
    ExistsSubstring := FALSE
 ELSE
    IF (TheSubStr = '')
     THEN
        ExistsSubstring := TRUE
     ELSE
        BEGIN
        TempBoolean := FALSE;

        IF CaseMatters
         THEN
            REPEAT
                IF (POS(TheSubStr,CurrentStrPtr^.GetString) > 0)
                 THEN TempBoolean := TRUE;
                 {ELSE leave TempBoolean alone}

                CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
             UNTIL (TempBoolean OR NoMoreStrings)
         ELSE
            REPEAT
                IF (POS(TheSubStr,StUpCase(CurrentStrPtr^.GetString)) > 0)
                 THEN TempBoolean := TRUE;
                 {ELSE leave TempBoolean alone}

                CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
             UNTIL (TempBoolean OR NoMoreStrings);

        ExistsSubstring := TempBoolean
        END
END; {StrLinkList.ExistsSubstring}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteStringsWithoutSubstring(TheSubStr  : STRING;
                                                    IgnoreCase : BOOLEAN);

   {This procedure deletes any string that doesn't contain TheSubStr as part
of the string.  No strings are deleted if TheSubString is a null string.  The
IgnoreCase variable dictates whether upper/lower case is relevant.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.DeleteStringsWithoutSubstring}
{Initialize.}
IF ((TheSubStr = '') OR (First = NIL))
 THEN EXIT; {no need to hang around, eh?}
InitCurrent;
Index := 1;

IF IgnoreCase
 THEN
    BEGIN
    TheSubStr := StUpCase(TheSubStr);
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,StUpCase(GetSpecificString(Index))) = 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
    END
 ELSE
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,GetSpecificString(Index)) = 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
END; {StrLinkList.DeleteStringsWithoutSubstring}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteStringsWithSubstring(TheSubStr  : STRING;
                                                 IgnoreCase : BOOLEAN);

   {This procedure deletes any string that DOES contain TheSubStr as part of
the string.  No strings are deleted if TheSubString is a null string.  The
IgnoreCase variable dictates whether upper/lower case is relevant.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.DeleteStringsWithSubstring}
{Initialize.}
IF ((TheSubStr = '') OR (First = NIL))
 THEN EXIT; {no need to hang around, eh?}
InitCurrent;
Index := 1;

IF IgnoreCase
 THEN
    BEGIN
    TheSubStr := StUpCase(TheSubStr);
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,StUpCase(GetSpecificString(Index))) > 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
    END
 ELSE
    WHILE (Index <= Total(First))
     DO IF (POS(TheSubStr,GetSpecificString(Index)) > 0)
         THEN DeleteSpecificString(Index)
         ELSE INC(Index)
END; {StrLinkList.DeleteStringsWithSubstring}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteDuplicates;

   {This procedure deletes duplicate strings from the list.}

VAR
   MasterIndex  : LONGINT;
   CurrentIndex : LONGINT;
   TestStr      : STRING;

BEGIN {StrLinkList.DeleteDuplicates}
{Initialize.}
MasterIndex := 1;
InitCurrent;
IF (UniqueStringsOnly OR (Total(First) < 2))
 THEN EXIT; {no need to hang around here, eh?}

{If we get this far, we have at least two strings on the list.}
REPEAT
    TestStr       := GetSpecificString(MasterIndex);  {sets CurrentStrPtr}
    CurrentIndex  := SUCC(MasterIndex);
    CurrentStrPtr := StrObjectPtr(Specific(CurrentIndex));

    IF CaseMatters
     THEN
        REPEAT
            IF (CurrentStrPtr^.GetString = TestStr)
             THEN
                BEGIN
                DeleteSpecificString(CurrentIndex);
                CurrentStrPtr := StrObjectPtr(Specific(CurrentIndex))
                END
             ELSE
                BEGIN
                Advance;
                INC(CurrentIndex)
                END
         UNTIL (CurrentIndex > Total(First))
     ELSE
        {$IFDEF TPRO5}
            REPEAT
                IF (CompUCString(CurrentStrPtr^.GetString,TestStr) = Equal)
                 THEN
                    BEGIN
                    DeleteSpecificString(CurrentIndex);
                    CurrentStrPtr := StrObjectPtr(Specific(CurrentIndex))
                    END
                 ELSE
                    BEGIN
                    Advance;
                    INC(CurrentIndex)
                    END
             UNTIL (CurrentIndex > Total(First));
        {$ELSE}
            REPEAT
                IF (StUpCase(CurrentStrPtr^.GetString) = StUpCase(TestStr))
                 THEN
                    BEGIN
                    DeleteSpecificString(CurrentIndex);
                    CurrentStrPtr := StrObjectPtr(Specific(CurrentIndex))
                    END
                 ELSE
                    BEGIN
                    Advance;
                    INC(CurrentIndex)
                    END
             UNTIL (CurrentIndex > Total(First));
        {$ENDIF}

    INC(MasterIndex)
 UNTIL (MasterIndex >= Total(First));

InitCurrent
END; {StrLinkList.DeleteDuplicates}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteLeadNullStrings;

   {This procedure deletes leading null strings from the list.  Null strings
that exist past the first non-null string in the list are left alone.}

BEGIN {StrLinkList.DeleteLeadNullStrings}
WHILE ((First <> NIL)
 AND (GetSpecificString(1) = ''))
 DO DeleteSpecificString(1)
END; {StrLinkList.DeleteLeadNullStrings}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteNullStrings;

   {This procedure deletes null strings from the list.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.DeleteNullStrings}
{Initialize.}
IF (First = NIL)
 THEN EXIT; {no need to hang around, eh?}
InitCurrent;
Index := 1;

WHILE (Index <= Total(First))
 DO IF (GetSpecificString(Index) = '')
     THEN DeleteSpecificString(Index)
     ELSE INC(Index)
END; {StrLinkList.DeleteNullStrings}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.DeleteTrailNullStrings;

   {This procedure deletes Trailing null strings from the list.  Null strings
that exist before the last non-null string in the list are left alone.}

BEGIN {StrLinkList.DeleteTrailNullStrings}
WHILE ((Last <> NIL)
 AND (GetSpecificString(Total(First)) = ''))
 DO DeleteSpecificString(Total(First))
END; {StrLinkList.DeleteTrailNullStrings}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.TotalLengthOfStrings : LONGINT;

   {Returns the total length of the strings on the list.  CurrentStrPtr points
to NO string after the call is made.}

VAR
   Index : LONGINT;

BEGIN {StrLinkList.TotalLengthOfStrings}
{Initialize.}
Index := 0;
InitCurrent;

WHILE MoreStrings
 DO BEGIN
    INC(Index,CurrentStrPtr^.GetStringLength);
    Advance
    END;

TotalLengthOfStrings := Index
END; {StrLinkList.TotalLengthOfStrings}
{============================================================================}

{============================================================================}
PROCEDURE  StrLinkList.InitCurrent;

   {This function initializes CurrentStrPtr to point to the first string on
the LinkList.  NoMoreStrings will return TRUE if there are no strings on the
list.}

BEGIN {StrLinkList.InitCurrent}
CurrentStrPtr := StrObjectPtr(First);
END; {StrLinkList.InitCurrent}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.CurrentString : STRING;

   {This function returns the current string in the StrLinkList.  It returns
a null string if the CurrentStrPtr is NIL.  It is up to the calling routine
to use the NoMoreStrings function to see if a string is currently available.}

BEGIN {StrLinkList.CurrentString}
IF NoMoreStrings
 THEN CurrentString := ''
 ELSE CurrentString := CurrentStrPtr^.GetString
END; {StrLinkList.CurrentString}
{============================================================================}

{============================================================================}
PROCEDURE StrLinkList.ChangeCurrentString(NewStr : STRING);

   {This procedure changes the current string to the new string.}

BEGIN {StrLinkList.ChangeCurrentString}
CurrentStrPtr^.ChangeString(NewStr)
END; {StrLinkList.ChangeCurrentString}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.FirstString : STRING;

   {This function simply returns the first String in the LinkList.  It returns
a null string if there are no strings in the list.  It is up to the calling
routine to determine for itself if there are no strings.}

BEGIN {StrLinkList.FirstString}
CurrentStrPtr := StrObjectPtr(First);
IF NoMoreStrings
 THEN FirstString := ''
 ELSE FirstString := CurrentStrPtr^.GetString
END; {StrLinkList.FirstString}
{============================================================================}

{============================================================================}
FUNCTION    StrLinkList.LastString : STRING;

   {This function simply returns the last string in the LinkList.  It returns
a null string if there are no strings in the list.  It is up to the calling
routine to determine for itself if there are no strings.}

BEGIN {StrLinkList.LastString}
CurrentStrPtr := StrObjectPtr(Last);
IF NoMoreStrings
 THEN LastString := ''
 ELSE LastString := CurrentStrPtr^.GetString
END; {StrLinkList.LastString}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.Advance;

   {This procedure simply moves to the next string in the StrLinkList.}

BEGIN {StrLinkList.Advance}
CurrentStrPtr := StrObjectPtr(Next(CurrentStrPtr))
END; {StrLinkList.Advance}
{============================================================================}

{============================================================================}
PROCEDURE   StrLinkList.Retreat;

   {This procedure simply moves to the previous string in the StrLinkList.
Use the MoreStrings or NoMoreStrings functions to determine if CurrentString
points to a valid string after you make this call.  Note:  Retreat will not
retreat past the first string on the list.}

BEGIN {StrLinkList.Retreat}
IF CurrentStrPtr = StrObjectPtr(First)
 THEN CurrentStrPtr := NIL
 ELSE CurrentStrPtr := StrObjectPtr(Prev(CurrentStrPtr))
END; {StrLinkList.Retreat}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.MoreStrings : BOOLEAN;

   {This function tells the calling routine if there are still some strings
left to go on the link list.}

BEGIN {StrLinkList.MoreStrings}
MoreStrings := (CurrentStrPtr <> NIL)
END; {StrLinkList.MoreStrings}
{============================================================================}

{============================================================================}
FUNCTION  StrLinkList.NoMoreStrings : BOOLEAN;

   {This function is just the opposite of MoreStrings.  It tells the calling
routine if the string link list has been exhausted.}

BEGIN {StrLinkList.NoMoreStrings}
NoMoreStrings := (CurrentStrPtr = NIL)
END; {StrLinkList.NoMoreStrings}
{============================================================================}


END. {StrLink}